home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 17 / CU Amiga Magazine's Super CD-ROM 17 (1997)(EMAP Images)(GB)[!][issue 1997-12].iso / CUCD / Programming / DiceSource / src / alib / csup / rexx_support / rexxvars.asm < prev    next >
Encoding:
Assembly Source File  |  1994-08-18  |  14.1 KB  |  428 lines
  1. * === rexxvars.asm =====================================================
  2. *
  3. * $Id: rexxvars.asm,v 30.8 1994/08/18 05:54:55 dice Exp dice $
  4. *
  5. * Copyright (c) 1988 William S. Hawes (All Rights Reserved)
  6. *
  7. * $Log: rexxvars.asm,v $
  8. ;; Revision 30.8  1994/08/18  05:54:55  dice
  9. ;; .
  10. ;;
  11. ;; Revision 30.0  1994/06/10  18:10:49  dice
  12. ;; .
  13. ;;
  14. ;; Revision 30.0  1994/06/10  18:10:49  dice
  15. ;; .
  16. ;;
  17. * Revision 36.1  90/08/28  10:03:12  mks
  18. * First "QUICK-FIX" of RexxVars.asm for the trashing of D2.
  19. * This is a correct fix but not most optimal.
  20. * 
  21. * Also, made to assemble on my system.
  22. * 
  23. * RexxVars.asm is now under RCS control
  24. * 
  25. * ======================================================================
  26. * Functions to implement the ARexx direct variable interface.
  27.  
  28.          INCLUDE  "rexx/storage.i"
  29.          INCLUDE  "rexx/rxslib.i"
  30.          INCLUDE  "rexx/errors.i"
  31.          INCLUDE  "rexx/rexx.i"
  32.  
  33. LINKSYS MACRO           ; link to a library without having to see a _LVO
  34.         MOVE.L  A6,-(SP)
  35.         MOVE.L  \2,A6
  36.         JSR     _LVO\1(A6)
  37.         MOVE.L  (SP)+,A6
  38.         ENDM
  39.  
  40. CALLSYS MACRO           ; call a library via A6 without having to see _LVO
  41.         JSR     _LVO\1(A6)
  42.         ENDM
  43.  
  44. XLIB    MACRO           ; define a library reference without the _LVO
  45.         XREF    _LVO\1
  46.         ENDM
  47. ;
  48.  
  49.          XREF     _AbsExecBase
  50.  
  51.          XDEF     CheckRexxMsg
  52.          XDEF     _CheckRexxMsg
  53.          XDEF     GetRexxVar
  54.          XDEF     _GetRexxVar
  55.          XDEF     SetRexxVar
  56.          XDEF     _SetRexxVar
  57.  
  58.          ; EXEC library routines
  59.  
  60.          XLIB     CloseLibrary
  61.          XLIB     OpenLibrary
  62.  
  63.          STRUCTURE StackFrame,0
  64.          APTR     sf_MsgPtr            ; message pointer
  65.          APTR     sf_Save1             ; 1st error trap
  66.          APTR     sf_Save2             ; 2nd error trap
  67.          LABEL    sf_SIZEOF            ; size: 12 bytes
  68.  
  69.  
  70. * Checks whether a message came from a valid REXX context.
  71. * Usage: boolean = CheckRexxMsg(rmptr);
  72. _CheckRexxMsg
  73.          move.l   4(sp),a0             ; message packet
  74.  
  75. * ========================     CheckRexxMsg     ========================
  76. * Verifies that the message represents a valid REXX context.
  77. * Registers:   A0 -- message
  78. * Return:      D0 -- boolean
  79. CheckRexxMsg
  80.          movem.l  d2/a2/a6,-(sp)
  81.          movea.l  a0,a2
  82.          movea.l  _AbsExecBase,a6      ; EXEC library base
  83.  
  84.          ; Open the REXX Systems library
  85.  
  86.          lea      RXSLib(pc),a1        ; library name
  87.          moveq    #0,d0                ; any version
  88.          CALLSYS  OpenLibrary
  89.          move.l   d0,d2                ; library opened?
  90.          beq.s    1$                   ; no??
  91.  
  92.          ; Close the library ...
  93.  
  94.          movea.l  d0,a1
  95.          CALLSYS  CloseLibrary
  96.  
  97.          ; Make sure the library matches the message LibBase pointer ...
  98.  
  99.          moveq    #0,d0                ; clear return
  100.          cmp.l    rm_LibBase(a2),d2    ; matches?
  101.          bne.s    1$                   ; no
  102.          move.l   rm_TaskBlock(a2),d1  ; global pointer?
  103.          beq.s    1$                   ; no
  104.  
  105.          ; Make sure the message came from REXX ...
  106.  
  107.          movea.l  a2,a0                ; message
  108.          movea.l  d2,a6                ; REXX base
  109.          CALLSYS  IsRexxMsg            ; D0=boolean
  110.  
  111. 1$:      tst.l    d0                   ; set CCR
  112.          movem.l  (sp)+,d2/a2/a6
  113.          rts
  114.  
  115. * Retrieves the value of a variable from the current storage environment.
  116. * USAGE: error = GetRexxVar(msgptr,name,&return);
  117. _GetRexxVar
  118.          movem.l  4(sp),a0/a1          ; message/variable name
  119.          bsr.s    GetRexxVar           ; D0=error A1=value
  120.          bne.s    1$                   ; ... error
  121.          movea.l  12(sp),a0            ; return pointer
  122.          move.l   a1,(a0)              ; install value
  123.  
  124. 1$:      rts
  125.  
  126. * =========================     GetRexxVar     =========================
  127. * Retrieves the value of a variable from the current storage environment.
  128. * Registers:   A0 -- context
  129. *              A1 -- variable name
  130. * Return:      D0 -- error code
  131. *              A1 -- value (argstring)
  132. GetRexxVar
  133.          movem.l  d2/d3/a2-a6,-(sp)
  134.          movea.l  a0,a2                ; save message
  135.          movea.l  a1,a3                ; save buffer
  136.  
  137.          ; Check for a valid context
  138.  
  139.          bsr      CheckRexxMsg         ; D0=boolean
  140.          beq.s    GRVErr10             ; invalid context
  141.          movea.l  rm_LibBase(a2),a6    ; REXX base
  142.  
  143.          ; Find the current storage environment
  144.  
  145.          movea.l  rm_TaskBlock(a2),a0  ; global pointer
  146.          CALLSYS  CurrentEnv           ; D0=A0=environment
  147.          movea.l  a0,a4                ; save it
  148.  
  149.          ; Create the stem and compound parts
  150.  
  151.          movea.l  a3,a0                ; name
  152.          bsr      TypeString           ; D0=error D1=compound A1=stem
  153.          bne.s    GRVOut               ; ... failure
  154.          movea.l  a1,a2                ; save stem
  155.          move.l   d1,d2                ; save compound
  156.  
  157.          ; Look up the value ...
  158.  
  159.          movea.l  a4,a0                ; environment
  160.          move.l   d2,d0                ; compound string
  161.          moveq    #0,d1                ; clear node
  162.          CALLSYS  FetchValue           ; D0=node  D1=flag  A1=value
  163.          moveq    #0,d0                ; all OK
  164.  
  165.          ; Check for a literal value (and return NULL)
  166.  
  167.          addq.l   #ns_Buff,a1          ; offset to string
  168.          tst.l    d1                   ; a literal?
  169.          beq.s    GRVOut               ; no
  170.          suba.l   a1,a1                ; clear pointer
  171.          bra.s    GRVOut
  172.  
  173.          ; Error conditions
  174.  
  175. GRVErr10 moveq    #10,d0               ; invalid context
  176.  
  177. GRVOut   tst.l    d0                   ; set CCR
  178.          movem.l  (sp)+,d2/d3/a2-a6
  179.          rts
  180.  
  181. * USAGE: error = SetRexxVar(message,name,value,length)
  182. _SetRexxVar
  183.          movem.l  4(sp),a0/a1
  184.          movem.l  12(sp),d0/d1
  185.  
  186. * =========================     SetRexxVar     =========================
  187. * Assigns a value to a variable in the current storage environment.
  188. * Registers:   A0 -- context
  189. *              A1 -- variable name
  190. *              D0 -- value
  191. *              D1 -- length
  192. * Return:      D0 -- error code
  193. STACKBF  SET      sf_SIZEOF
  194. SetRexxVar
  195.          movem.l  d2-d7/a2-a6,-(sp)
  196.          lea      -STACKBF(sp),sp      ; stack frame
  197.          movea.l  a0,a2                ; save message
  198.          movea.l  a1,a3                ; save name
  199.          movea.l  d0,a5                ; save value
  200.          move.l   d1,d3                ; save length
  201.  
  202.          ; Install our own error trap
  203.  
  204.          lea      SRVErr3(pc),a0       ; trap location
  205.          movea.l  sp,a1                ; stack frame
  206.          bsr      SaveTrap
  207.  
  208.          ; Check for a valid context
  209.  
  210.          movea.l  a2,a0                ; message packet
  211.          bsr      CheckRexxMsg         ; D0=boolean
  212.          beq.s    SRVErr10             ; invalid context
  213.          movea.l  rm_LibBase(a2),a6    ; REXX base
  214.  
  215.          ; Make sure the value string is not too long
  216.  
  217.          moveq    #9,d0                ; string too long
  218.          cmpi.l   #65535,d3            ; too long?
  219.          bgt.s    SRVOut               ; yes
  220.  
  221.          ; Find the current storage environment
  222.  
  223.          movea.l  rm_TaskBlock(a2),a0  ; global pointer
  224.          CALLSYS  CurrentEnv           ; D0=A0=environment
  225.          movea.l  a0,a4                ; save environment
  226.  
  227.          ; Create the stem and compound parts ...
  228.  
  229.          movea.l  a3,a0                ; variable name
  230.          bsr      TypeString           ; D0=error D1=compound A1=stem
  231.          bne.s    SRVOut               ; ... failure
  232.          movea.l  a1,a2                ; save stem
  233.          move.l   d1,d2                ; save compound
  234.  
  235.          ; Locate or create the symbol node ...
  236.  
  237.          movea.l  a4,a0                ; environment
  238.          move.l   d2,d0                ; compound string
  239.          CALLSYS  EnterSymbol          ; D0=A0=node A1=value
  240.          move.l   d0,d4                ; save node
  241.  
  242.          ; Create the value string ...
  243.  
  244.          movea.l  a4,a0                ; environment
  245.          movea.l  a5,a1                ; pointer
  246.          move.l   d3,d0                ; length
  247.          bsr      MakeString           ; D0=A0=string
  248.          beq.s    SRVErr3              ; ... failure
  249.  
  250.          ; Install the value string
  251.  
  252.          movea.l  a4,a0                ; environment
  253.          movea.l  d0,a1                ; value string
  254.          move.l   d4,d0                ; symbol table node
  255.          CALLSYS  SetValue             ; D0=node A1=value
  256.  
  257.          moveq    #0,d0
  258.          bra.s    SRVOut
  259.  
  260.          ; Error conditions
  261.  
  262. SRVErr3  moveq    #3,d0                ; allocation failure
  263.          bra.s    SRVOut
  264.  
  265. SRVErr10 moveq    #10,d0               ; invalid context
  266.  
  267. SRVOut   movea.l  sp,a0                ; stack level
  268.          move.l   d0,-(sp)             ; push error
  269.          bsr      RestoreTrap
  270.          move.l   (sp)+,d0             ; pop error
  271.  
  272.          lea      STACKBF(sp),sp
  273.          movem.l  (sp)+,d2-d7/a2-a6
  274.          rts
  275.  
  276. * =========================     TypeString     =========================
  277. * Classifies a symbol and returns the stem and compound parts.
  278. * Registers:   A0 -- variable name
  279. *              A4 -- environment
  280. * Return:      D0 -- error code
  281. *              D1 -- compound name
  282. *              A1 -- stem name
  283. TypeString
  284.          movem.l  d2/d3/a2/a3,-(sp)
  285.          moveq    #0,d2                ; clear error
  286.          moveq    #0,d3
  287.  
  288.          CALLSYS  Strlen               ; D0=length
  289.          movea.l  a0,a1
  290.          movea.l  a4,a0                ; environment
  291.          bsr.s    MakeString           ; D0=A0=string
  292.          movea.l  d0,a2                ; save string
  293.          beq.s    TSErr3               ; failure ...
  294.  
  295.          ; Now check whether it looks like a stem ...
  296.  
  297.          lea      ns_Buff(a2),a1       ; buffer area
  298.          move.w   ns_Length(a2),d0     ; length
  299.          move.l   a1,d1
  300.  
  301. 1$:      cmpi.b   #'.',(a1)+           ; a period?
  302.          dbeq     d0,1$                ; loop back
  303.          bne.s    2$                   ; not compound
  304.  
  305.          exg      d1,a1                ; begin=>A1 , end=>D1
  306.          sub.l    a1,d1                ; stem length
  307.          move.l   a2,d3                ; compound part
  308.  
  309.          ; Create the stem string ...
  310.  
  311.          movea.l  a4,a0                ; environment
  312.          move.l   d1,d0                ; length
  313.          bsr.s    MakeString           ; D0=A0=string
  314.          movea.l  d0,a2                ; save it
  315.          beq.s    TSErr3               ; failure
  316.  
  317.          ; Check for a valid stem ...
  318.  
  319. 2$:      lea      ns_Buff(a2),a0       ; string pointer
  320.          CALLSYS  IsSymbol             ; D0=code D1=length
  321.          cmp.w    ns_Length(a2),d1     ; full length?
  322.          beq.s    TSOut                ; yes
  323.  
  324.          moveq    #40,d2               ; variable expected
  325.          bra.s    TSOut
  326.  
  327. TSErr3   moveq    #3,d2                ; allocation failure
  328.  
  329. TSOut    tst.l    d2                   ; error?
  330.          beq.s    1$                   ; no ... all OK
  331.  
  332.          ; Release intermediate strings ...
  333.  
  334.          movea.l  a4,a0                ; environment
  335.          movea.l  a2,a1                ; stem part
  336.          bsr.s    FreeString           ; release it
  337.  
  338.          movea.l  a4,a0                ; environment
  339.          movea.l  d3,a1                ; compound part
  340.          bsr.s    FreeString           ; release it
  341.  
  342. 1$:      movea.l  a2,a1                ; stem return
  343.          move.l   d3,d1                ; compound return
  344.          move.l   d2,d0                ; set CCR
  345.          movem.l  (sp)+,d2/d3/a2/a3
  346.          rts
  347.  
  348. * =========================     MakeString     =========================
  349. * Allocates and initializes a string structure.
  350. * Registers:   A0 -- environment
  351. *              A1 -- string
  352. *              D0 -- length
  353. * Return:      D0 -- string structure
  354. *              A0 -- same
  355. MakeString
  356.          movem.l  d0/a1,-(sp)          ; push length/pointer
  357.          addq.l   #ns_Buff,d0          ; add offset
  358.          addq.l   #1,d0                ; plus null byte
  359.          CALLSYS  GetSpace             ; D0=A0=structure
  360.          movem.l  (sp)+,d0/a1          ; pop length/pointer
  361.          beq.s    1$                   ; failure ...
  362.  
  363.          move.l   a0,-(sp)             ; push pointer
  364.          clr.l    (a0)
  365.          move.w   d0,ns_Length(a0)
  366.          move.b   #NSF_STRING,ns_Flags(a0)
  367.          clr.b    ns_Buff(a0,d0.l)     ; null byte
  368.          addq.l   #ns_Buff,a0          ; offset to buffer
  369.          CALLSYS  StrcpyN              ; D0=hash
  370.          movea.l  (sp)+,a0             ; pop pointer
  371.          move.b   d0,ns_Hash(a0)       ; install hash byte
  372.  
  373. 1$:      move.l   a0,d0                ; set CCR
  374.          rts
  375.  
  376. * ========================     FreeString     ==========================
  377. * Releases a string structure, if it's not owned at the time.
  378. * Registers:   A0 -- environment
  379. *              A1 -- string structure
  380. FreeString
  381.          move.l   a1,d1
  382.          beq.s    1$
  383.          moveq    #NSF_KEEP,d0         ; ownership bits
  384.          and.b    ns_Flags(a1),d0      ; owned?
  385.          bne.s    1$                   ; yes
  386.  
  387.          move.w   ns_Length(a1),d0     ; string length
  388.          addq.l   #ns_Buff,d0          ; add offset
  389.          addq.l   #1,d0                ; plus null byte
  390.          CALLSYS  FreeSpace
  391.  
  392. 1$:      rts
  393.  
  394. * ==========================     SaveTrap     ==========================
  395. * Saves the global error code
  396. * Registers:   A0 -- trap location
  397. *              A1 -- stack level
  398. *              A2 -- message packet
  399. SaveTrap
  400.          move.l   a3,-(sp)
  401.          movea.l  rm_TaskBlock(a2),a3  ; global context
  402.  
  403.          move.l   a2,sf_MsgPtr(a1)
  404.          movem.l  rt_ErrTrap(a3),d0/d1 ; old trap
  405.          movem.l  a0/a1,rt_ErrTrap(a3) ; new trap
  406.          movem.l  d0/d1,sf_Save1(a1)   ; save old trap
  407.  
  408.          movea.l  (sp)+,a3
  409.          rts
  410.  
  411. * =========================     RestoreTrap     ========================
  412. * Restores the global error trap values for the REXX context.
  413. * Registers:   A0 -- stack frame
  414. RestoreTrap
  415.          movea.l  sf_MsgPtr(a0),a1
  416.          movea.l  rm_TaskBlock(a1),a1  ; global context
  417.  
  418.          movem.l  sf_Save1(a0),d0/d1   ; saved trap values
  419.          movem.l  d0/d1,rt_ErrTrap(a1) ; restore values
  420.          rts
  421.  
  422.          ; String data
  423.  
  424. RXSLib   RXSLIBNAME                    ; library name
  425.          CNOP     0,2
  426.  
  427.          END
  428.